home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr18
/
mrun210.zip
/
MRUN210E.WAS
< prev
next >
Wrap
Text File
|
1993-04-28
|
20KB
|
763 lines
;MailRun v2.10: Part E, addulfile
;1992-1993 Gerald P. Sully, all rights reserved.
#comment
**************************************************************************
**************************************************************************
*
* This file contains routines related to adding a "Upload File"
* item to a mailrun. It puts up the Upload Files dialog box,
* which displays the contents of the available files index (the
* *.udx file for the mailrun). When a file is selected from the
* list, a detailed description is displayed from the *.ubf file
* for the mailrun).
*
**************************************************************************
**************************************************************************
#endcomment
#define MRUN210E
#define MRUN210DE
#include "mrun210.h"
string DXFileTabs, OldUDX, OldUBF, MRunUDX, MRunUBF, LastChoice
string UploadDir, DownloadDir
integer InULDir, ULSortField
#comment
*********************************************************************
*
* MAIN()
*
* Calls checkchild(), updateudx(), interfaceon(), getnewdesc(),
* getbbsi(), getitemi(), getulfiles(), checkchanged(),
* getbbscoord(), getitemcoord(), gettaskstring(),
* makebbslist(), ulfilebox(), insertulfile(), delulfile(),
* menudim(), makefullname(), sortidx(), checkfile(),
* clearfiledesc()
*
* Adds a SendFile item to the mailrun. An feditbox is
* used to display the file description in order to take
* advantage of wordwrap. The flistbox displays the
* contents of MAILRUN.UDX, which contains information on
* any file downloaded by MailRun, plus additional files
* found in the upload directory. A file description must
* be at least 6 characters, but may be as long as needed.
*
*********************************************************************
#endcomment
proc main
string LastUDX, LastUBF, FullFileName, temp
integer dialogstatus
integer i, j, InUDX
menudim()
checkchild()
findfirst MailRun
MailRunTrunc = $FILENAME
DXFileTabs = "58,92,130,305,315,319,322,325,328"
profilerd MailRun "MailRun" "UploadDir" UploadDir
profilerd MailRun "MailRun" "DownloadDir" DownloadDir
profilerd MailRun "MailRun" "ULSortField" ULSortField
i = getbbsi()
j = getitemi()
FileDesc = makefullname(TempDir, "DESC.TMP")
OldUDX = makefullname(TempDir, "OLDUDX.TMP")
OldUBF = makefullname(TempDir, "OLDUBF.TMP")
LastUDX = makefullname(MailRunDir, "MAILRUN.UDX")
LastUBF = makefullname(MailRunDir, "MAILRUN.UBF")
MRunUDX = makefullname(TempDir, "MAILRUN.UDX")
MRunUBF = makefullname(TempDir, "MAILRUN.UBF")
if isfile FileDesc
delfile FileDesc
endif
if isfile MRunUDX
delfile MRunUDX
endif
if isfile MRunUBF
delfile MRunUBF
endif
copyfile LastUDX MRunUDX
copyfile LastUBF MRunUBF
if not (checkfile(MRunUDX) && checkfile(MRUNUBF))
getulfiles()
endif
LastChoice = ""
FLAGS &= UNCHANGED
interfaceon()
makebbslist()
ulfilebox()
dialogstatus = $DIALOG
while dialogstatus != 1
switch dialogstatus
case 10
;User selected "Add"
insertulfile(&j)
TaskItem = gettaskstring(i, j)
endcase
case 11
;User selected "Save"
if FLAGS & CHANGED
updateudx()
FLAGS &= UNCHANGED
updatedlg -1
endif
endcase
case 12
;User selected "Delete"
delulfile()
endcase
case 13
;User selected "Refresh"
statmsg "Refreshing Uploads List from Upload Directory..."
getulfiles()
updatedlg -1
statmsg ""
endcase
case 50
;User selected a sort radiobutton
profilewr MailRun "MailRun" "ULSortField" ULSortField
sortidx(MRunUDX, ULSortField)
updatedlg 16
endcase
case 130
;User selected a file from the listbox
if checkchanged()
getnewdesc()
updatedlg 137
else
FileChoice = LastChoice
updatedlg 16
endif
endcase
case 170
;User changed BBSs with the combobox
i = getbbscoord()
j = getitemcoord()
TaskItem = gettaskstring(i, 0)
endcase
case 230
;User entered a name in the File Name box
FullFileName = makefullname(UploadDir, FileName)
if isfile FullFileName
InULDir = 1
else
InULDir = 0
endif
interfaceoff()
openfile(MRunUDXFile, MRunUDX, _READWRITE, _TEXT)
InUDX = checkudx(FileName)
if InUDX
fseek MRunUDXFile -100 1
fgets MRunUDXFile FileChoice
fgets MRunUDXFile FileChoice
strextract temp FileChoice "`t" 0
while not strcmpi temp FileName
fgets MRunUDXFile FileChoice
strextract temp FileChoice "`t" 0
endwhile
endif
fclose MRunUDXFile
interfaceon()
if InUDX
makedesc(MRunUBF)
else
clearfiledesc()
endif
updatedlg -1
endcase
case 250
;User entered a file description
if !(FLAGS & CHANGED)
FLAGS |= CHANGED
endif
endcase
endswitch
dialogstatus = $DIALOG
endwhile
delfile LastUDX
delfile LastUBF
copyfile MRunUDX LastUDX
copyfile MRunUBF LastUBF
endproc
#comment
*********************************************************************
*
* INSERTULFILE()
*
* Called by main()
*
* Calls checkperm(), openfile(), updateudx(), insertitem(),
* interfaceon(), interfaceoff(), makefullname(), checkudx(),
* clearfiledesc(), shortdesc()
*
* Adds a SendFile item to the *.MRN file and the task list.
*
*********************************************************************
#endcomment
proc insertulfile
intparm j
string ULDescString, ULFileString, FullFileName
string ULFileSpec, Perm
string StatString, CopyboxMsg
integer ULDescLength
integer Response, InUDX
interfaceoff()
if NULLSTR FileName
;User hasn't selected a file
usermsg "You must select a file first."
return
endif
if InULDir == 0
strupr FileName
strfmt CopyBoxMsg \
"%s is not in the Upload Directory.`r`nCopy it now?" \
FileName
strlwr FileName
sdlgmsgbox "MailRun Message" CopyBoxMsg QUESTION \
OKCANCEL Response 1
switch Response
case 1
;User selected "OK"
ULFileSpec = makefullname(DownloadDir, FileName)
dir ULFileSpec FullFileName
if NULLSTR FullFileName
return
endif
if not isfile FullFileName
sdlgmsgbox "MailRun Message" "No such file!" \
EXCLAMATION OK Response 1
return
endif
copyfile FullFileName UploadDir
if not strcmpi ULFileSpec FullFileName
;if the user chose a file other than the one specified
;get the name of the file
findfirst FullFileName
FileName = $FILENAME
strlwr FileName
;determine whether it is already in the uploads database
openfile(MRunUDXFile, MRunUDX, _READWRITE, _TEXT)
InUDX = checkudx(FileName)
fclose MRunUDXFile
if InUDX == 0
;if it isn't in the uploads database, put it there
clearfiledesc()
FLAGS |= CHANGED
updateudx()
endif
endif
InULDir = 1
updatedlg -1
endcase
case 2
;User selected "Cancel"
return
endcase
endswitch
endif
;No description may be less than 30 characters
openfile(FileDescFile, FileDesc, _READWRITE, _NORMAL)
fread FileDescFile ULDescString 65 ULDescLength
fclose FileDescFile
if ULDescLength < 6
usermsg "Please enter a longer description."
elseif shortdesc(ULDescString, ULDescLength)
;If everything is OK...
if FLAGS & CHANGED
;Add the new description to the database
updateudx()
FLAGS &= UNCHANGED
updatedlg 16
endif
Perm = checkperm()
strupr FileName
strfmt ULFileString \
"1,%s,SendFile,%s,%s" Perm FileName Conf
strfmt StatString \
"Added to %s: `"Upload %s to Conference %s`"" \
BBS FileName Conf
j++
insertitem(j, ULFileString)
strlwr FileName
statmsg StatString
endif
interfaceon()
endproc
#comment
*********************************************************************
*
* SHORTDESC()
*
* Called by insertulfile()
*
* Calls findstring()
*
* If the current BBS type is WildCat! or RBBS, limits the
* upload description length to 60 or 45 characters,
* respectively. Gives user an opportunity to enter a new
* description if the current one is too long.
*
*********************************************************************
#endcomment
func shortdesc : integer
strparm ULDescString
intparm ULDescLength
string ULMsg, TypeName
integer Response, MaxLength
profilerd MailRun BBS "BBSType" BBSType
if (findstring(BBSType, "WildCat") && (ULDescLength > 60)) || \
(findstring(BBSType, "RBBS") && (ULDescLength > 45))
if findstring(BBSType, "WildCat")
substr ULDescString ULDescString 0 60
MaxLength = 60
TypeName = "WildCat!"
else
substr ULDescString UlDescString 0 45
MaxLength = 45
TypeName = "RBBS"
endif
strfmt ULMsg "A %s file description has a maximum length \
of %d characters. The description for %s will be truncated to read:\
`r`n`r`n%s`r`n`r`nDo you wish to continue?" \
TypeName MaxLength FileName ULDescString
sdlgmsgbox "MailRun Message" ULMsg QUESTION YESNO Response 2
switch Response
case 6
return 1
endcase
case 7
return 0
endcase
endswitch
else
return 1
endif
endfunc
#comment
*********************************************************************
*
* DELULFILE()
*
* Called by main()
*
* Calls killfile(), makefullname()
*
* Deletes a file from the upload database index.
*
*********************************************************************
#endcomment
proc delulfile
string DelBoxMsg, FullFileName
integer Response
if not NULLSTR FileName
if InULDir == 1
;If the selected file is in the upload directory
strfmt DelBoxMsg "Delete file %s as well?" FileName
sdlgmsgbox "MailRun Message" DelBoxMsg QUESTION \
YESNOCANCEL Response 1
switch Response
case 2
;User selected "Cancel"
return
endcase
case 6
;User selected "Yes"
FullFileName = makefullname(UploadDir, FileName)
delfile FullFileName
case 7
;User selected "No"
killfile()
endcase
endswitch
else
killfile()
endif
FLAGS &= UNCHANGED
updatedlg -1
endif
endproc
#comment
*********************************************************************
*
* KILLFILE()
*
* Called by delulfile()
*
* Calls openfile(), clearfiledesc(), getnewdesc()
*
* Deletes a file from the upload database index.
*
*********************************************************************
#endcomment
proc killfile
string UDXString, UDXFile, temp
;Copy all but the new description to the new UDX file
copyfile MRunUDX OldUDX
openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT)
openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;Read lines until the end of file or the current file
strextract UDXFile UDXString "`t" 0
if strcmpi UDXFile FileName
exitwhile
endif
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
fgets OldUDXFile UDXString
;get the new listbox selection
FileChoice = UDXString
while not feof OldUDXFile
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
if NULLSTR FileChoice
;if the deleted line was the last in the file
;back up one line and read it
fseek MRunUDXFile -100 2
fgets MRunUDXFile temp
while not NULLSTR temp
FileChoice = temp
fgets MRunUDXFile temp
endwhile
endif
if not NULLSTR FileChoice
getnewdesc()
else
FileName = ""
clearfiledesc()
endif
fclose OldUDXFile
fclose MRunUDXFile
delfile OldUDX
endproc
#comment
*********************************************************************
*
* GETNEWDESC()
*
* Called by main(), killfile()
*
* Calls makedesc(), makefullname()
*
* Gets the file name and description from the index entry
* and determines whether the file is in the upload directory.
*
*********************************************************************
#endcomment
proc getnewdesc
string FullFileName
LastChoice = FileChoice
strextract FileName FileChoice "`t" 0
FullFileName = makefullname(UploadDir, FileName)
if isfile FullFileName
InULDir = 1
else
InULDir = 0
endif
makedesc(MRunUBF)
endproc
#comment
*********************************************************************
*
* GETULFILES()
*
* Called by main()
*
* Calls openfile(), checkudx(), checkfile(), sortidx(),
* interfaceon(), interfaceoff(), makefullname()
*
* Updates the Upload directory file description database.
*
*********************************************************************
#endcomment
proc getulfiles
string FileSize, FileDate, FDesc, DescBegin, DescLength, UDXString
string ULFileFull, ULFileTrunc, FullFileName
long FS, DB, DL, NDB, counter
integer char
integer InUDX
interfaceoff()
if checkfile(MRunUDX) && checkfile(MRunUBF)
copyfile MRunUDX OldUDX
copyfile MRunUBF OldUBF
openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT)
openfile(OldUBFFile, OldUBF, _READWRITE, _NORMAL)
else
openfile(OldUDXFile, OldUDX, _CREATE, _TEXT)
openfile(OldUBFFile, OldUBF, _CREATE, _NORMAL)
endif
openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT)
openfile(MRunUBFFile, MRunUBF, _CREATE, _NORMAL)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;loop through the old .UDX file
;extract all fields
strextract ULFileTrunc UDXString "`t" 0
strextract FileSize UDXString "`t" 1
strextract FileDate UDXString "`t" 2
strextract FDesc UDXString "`t" 3
strextract DescBegin UDXString "`t" 4
strextract DescLength UDXString "`t" 5
atol DescBegin DB
atol DescLength DL
ftell MRunUBFFile NDB
;go to the beginning of the file description
fseek OldUBFFile DB 0
;copy the description to the new .UBF file
for counter = 1 upto DL
fgetc OldUBFFile char
fputc MRunUBFFile char
endfor
;add the index line to the new .UDX file
fstrfmt MRunUDXFile "%s`t%s`t%s`t%s`t%ld`t%ld`r`n" \
ULFileTrunc FileSize FileDate FDesc NDB DL
fgets OldUDXFile UDXString
endwhile
;Add any new files found in the uploads directory
FullFileName = makefullname(UploadDir, "*.*")
findfirst FullFileName
while FOUND
;Loop through all files in the upload directory
ULFileTrunc = $FILENAME
InUDX = checkudx(ULFileTrunc)
if InUDX == 0
ULFileFull = makefullname(UploadDir, ULFileTrunc)
getfsize ULFileFull FS
getfdate ULFileFull FileDate
strlwr ULFileTrunc
fseek MRunUDXFile 0 2
fstrfmt MRunUDXFile "%s`t%ld`t%s`t`t0`t0`r`n" \
ULFileTrunc FS FileDate
endif
findnext
endwhile
fclose MRunUDXFile
fclose MRunUBFFile
fclose OldUDXFile
fclose OldUBFFile
delfile OldUDX
delfile OldUBF
interfaceon()
sortidx(MRunUDX, ULSortField)
endproc
#comment
*********************************************************************
*
* CHECKUDX()
*
* Called by insertulfile(), getulfiles()
*
* Checks whether a given file is already in the UDX List.
* If it is, a value of 1 is returned, if not, the file
* is added to the list and a value of 0 is returned.
*
*********************************************************************
#endcomment
func checkudx : integer
strparm CkFileName
string UDXFile, UDXFileString
integer InUDX
rewind MRunUDXFile
InUDX = 0
fgets MRunUDXFile UDXFileString
while not feof MRunUDXFile
strextract UDXFile UDXFileString "`t" 0
if strcmpi CkFileName UDXFile
InUDX = 1
exitwhile
endif
fgets MRunUDXFile UDXFileString
endwhile
return InUDX
endfunc
#comment
*********************************************************************
*
* UPDATEUDX()
*
* Called by main(), insertulfile()
*
* Calls openfile(), interfaceon(), interfaceoff(),
* makefullname(), sortidx()
*
* Updates the Upload directory file description database
* and index files.
*
*********************************************************************
#endcomment
proc updateudx
string FileDate, FileSize, FullFileName
string ULDescString, UDXString, UDXFile
long DescBegin, DescLength, l
integer ULDescLength
integer char
interfaceoff()
;Copy all but the new description to the new UDX file
copyfile MRunUDX OldUDX
openfile(OldUDXFile, OldUDX, _READWRITE, _TEXT)
openfile(MRunUDXFile, MRunUDX, _CREATE, _TEXT)
fgets OldUDXFile UDXString
while not feof OldUDXFile
;Read lines until the end of file or the current file
strextract UDXFile UDXString "`t" 0
if strcmpi UDXFile FileName
exitwhile
endif
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
;Get the size and date
if NULLSTR UDXString
FullFileName = makefullname(UploadDir, FileName)
if isfile FullFileName
getfsize FullFileName l
ltoa l FileSize
getfdate FullFileName FileDate
InULDir = 1
else
FileSize = "???"
FileDate = "??/??/??"
InULDir = 0
endif
else
strextract FileSize UDXString "`t" 1
strextract FileDate UDXString "`t" 2
endif
;Discard the old description line
fgets OldUDXFile UDXString
FileChoice = UDXString
while not feof OldUDXFile
fputs MRunUDXFile UDXString
fgets OldUDXFile UDXString
endwhile
openfile(MRunUBFFile, MRunUBF, _READWRITE, _NORMAL)
;go to the end of the description database
fseek MRunUBFFile 0 2
ftell MRunUBFFile DescBegin
DescLength = 0
ULDescLength = 0
ULDescString = ""
;read characters from the description box into the database
openfile(FileDescFile, FileDesc, _READWRITE, _NORMAL)
fgetc FileDescFile char
while not feof FileDescFile
;read characters until all have been read
if ((char >= 0x20) && (char <= 0x7E)) || \
((char >= 0xA0) && (char <= 0xFE))
;Ignore non-printing characters
fputc MRunUBFFile char
if ULDescLength < 46
;No special characters in the index file either
strfmt ULDescString "%s%c" ULDescString char
ULDescLength++
endif
DescLength++
endif
fgetc FileDescFile char
endwhile
fclose MRunUBFFile
fclose FileDescFile
;Strip partial words from end of description
if ULDescLength == 46
ULDescLength--
strpeek ULDescString ULDescLength char
while char > 32
strdelete ULDescString ULDescLength 1
ULDescLength--
strpeek ULDescString ULDescLength char
endwhile
endif
strfmt FileChoice "%s`t%s`t%s`t%s`t%ld`t%ld" \
FileName FileSize FileDate ULDescString DescBegin DescLength
fputs MRunUDXFile FileChoice
fclose OldUDXFile
fclose MRunUDXFile
delfile OldUDX
sortidx(MRunUDX, ULSortField)
interfaceon()
endproc
#comment
*********************************************************************
*
* ULFILEBOX()
*
* Called by main()
*
* Draws the Upload Files Dialog Box.
*
*********************************************************************
#endcomment
proc ulfilebox
PermRadio = 2
Conf = "0"
FileName = ""
destroydlg
HelpPage = 10
dialogbox 19 38 324 201 15 "Upload Files" HELPID HelpPage
text 12 27 56 8 left "Filename"
text 70 27 40 8 left "Size"
text 104 27 34 8 left "Date"
text 142 27 117 8 left "Description"
flistbox 12 38 300 50 MRunUDX DXFileTabs single FileChoice
groupbox 12 89 300 17
radiobutton 26 94 60 11 "Unsorted" ULSortField
radiobutton 91 94 67 11 "Sort by Name"
radiobutton 172 94 61 11 "Sort by Size"
radiobutton 241 94 62 11 "Sort by Date" endgroup
text 13 112 49 8 left "Filename:"
editbox 12 122 101 12 FileName
text 129 112 67 8 left "Description:"
feditbox 129 122 182 50 FileDesc
text 14 158 78 8 right "U/L to Conference:"
editbox 96 156 16 12 Conf
radiobutton 12 178 53 13 "Permanent" PermRadio
radiobutton 70 178 54 13 "Temporary" endgroup
pushbutton 130 179 30 14 "&Add" normal default
pushbutton 168 179 30 14 "&Save" normal
pushbutton 206 179 30 14 "De&lete" normal
pushbutton 244 179 30 14 "&Refresh" normal
pushbutton 282 179 30 14 "&Done" cancel
text 76 9 80 8 right "Upload File to:"
combobox 160 7 70 42 BBSList BBS sort
checkbox 13 140 100 10 "File in uploads directory?" InULDir
enddialog
disable CTRL 70
endproc